home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0092_Ribbon scroll...pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  3KB  |  102 lines
  1.  
  2. {Ribbon scroller...programmed by Glen Jeh in Turbo Pascal 7.0, 4/24/94
  3.  Use freely}
  4.  
  5. {$R+}
  6. program RibbonScroll;  {this is IT}
  7. uses Crt, Dos;
  8.  
  9.      { I turned on range checking to slow it down :) }
  10.  
  11. const
  12.   YLocation = 100;  {position on the screen...}
  13.   Constant = 8;     {mess with this to use different parts of the curve}
  14.   Radius = 30;      {this is how big of a curve you want}
  15.   Width  = 10;      {wrong name..this is actually the waviness of the curve}
  16.   Spacing = 4;      {this is how fat the chars will be..or something}
  17.   Height = 1.5;     {this is how tall each character will be}
  18.   DispStr : string = 'Adjust the above constants <WRAP>...   ';
  19.  
  20.   Rows   = 8; {don't change this}
  21.  
  22. {testing}
  23. type
  24.   CharType = array[1..8] of Byte;
  25.   PathType = array[1..320 div Spacing] of
  26.     record
  27.       Pos : Word; {position in memory}
  28.       On  : Boolean; {on or off?}
  29.     end;
  30.              {this keeps track of the Y-Pos of the dot at X}
  31. var
  32.   CharSet : array[0..255] of CharType absolute $F000:$FA6E;
  33.   PathArray : array[1..Rows] of PathType;
  34.   I,
  35.   I2,
  36.   DispLine : Integer;
  37.  
  38. function GetNext(Row : Integer) : Boolean;
  39. var
  40.   CharNum,
  41.   ColumnNum : Integer;
  42. begin
  43.   CharNum := DispLine div 8 + 1;
  44.   ColumnNum := DispLine mod 8 + 1;
  45.   GetNext := CharSet[Ord(DispStr[CharNum])][Row] shr (8 - ColumnNum) and 1 = 1;
  46. end;
  47.  
  48.  
  49. function F(X:Real): Real;
  50. begin
  51.   F := (Sin ((X + Constant) / Width) * Radius + YLocation)
  52. end;
  53.  
  54.  
  55. procedure Mode(B : Byte);
  56. var
  57.   Regs : Registers;
  58. begin
  59.   Regs.ah := 0;
  60.   Regs.al := B;
  61.   Intr($10,Regs);
  62. end;
  63.  
  64. procedure BuildPath;
  65. begin
  66.   for I := 1 to Rows do
  67.     for I2 := 1 to 320 div Spacing do
  68.       begin
  69.         PathArray[I][I2].Pos := Round(F(I2+Height*I));
  70.           {compute Y location first}
  71.  
  72.         PathArray[I][I2].Pos :=
  73.           (PathArray[I][I2].Pos - 1) * 320 + (I2 * Spacing) - 1;
  74.           {compute memory location}
  75.       end
  76. end;
  77.  
  78.  
  79. begin
  80.   Mode($13);
  81.   BuildPath;
  82.   DispLine := 1;
  83.   repeat
  84.     repeat until (Port[$3DA] and $08) <> 0;
  85.     for I := 1 to 8 do
  86.       begin
  87.         for I2 := 1 to (320 div Spacing) - 1 do
  88.           PathArray[I][I2].On := PathArray[I][I2 + 1].On;
  89.         PathArray[I][320 div Spacing].On := GetNext(I);
  90.         for I2 := 1 to 320 div Spacing do
  91.           if PathArray[I][I2].On then
  92.             Mem[$A000:PathArray[I][I2].Pos] := I2 mod (100 - 50) + 50
  93.           else
  94.             Mem[$A000:PathArray[I][I2].Pos] := 0;
  95.       end;
  96.     Inc(DispLine);
  97.     if DispLine = 8 * Length(DispStr) then
  98.       DispLine := 1;
  99.   until KeyPressed;
  100.   Mode($3);
  101. end.
  102.